home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol285 / updatper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-03-15  |  14.6 KB  |  518 lines
  1. 100  REM UPDATPER Program.
  2. 110  REM Data Entry to the Persons File
  3. 120  REM Copyright (c) 1983 - 1987 by: Melvin O. Duke.
  4. 130  DEFINT A-Z
  5. 600  REM Titles
  6. 610  TITLE$ = "Update the Persons File"
  7. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  8. 700  REM Terminate if not called from the Menu
  9. 710  IF DD.MENU$ <> "" THEN 770
  10. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  11. 730  PRINT "Cannot run the"
  12. 740  PRINT TITLE$
  13. 750  PRINT "Program, unless selected from the MENU"
  14. 760  END
  15. 770  REM OK
  16. 1000  REM Produce the first screen
  17. 1010  KEY ON : CLS : KEY OFF
  18. 1020  REM Draw the outer double box
  19. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  20. 1040  REM Find the title location
  21. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  22. 1060  REM Draw the title box
  23. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  24. 1080  REM Print the title
  25. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  26. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  27. 1230  REM Draw the Copyright box
  28. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  29. 1250  REM Print the Copyright
  30. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  31. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  32. 1280  GOTO 1700
  33. 1300  REM subroutine to print a double box
  34. 1310  COLOR P
  35. 1320  FOR I = R1 + 1 TO R2 - 1
  36. 1330   LOCATE I, C1 : PRINT CHR$(186);
  37. 1340   LOCATE I, C2 : PRINT CHR$(186);
  38. 1350  NEXT I
  39. 1360   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  40. 1390   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
  41. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  42. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  43. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  44. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  45. 1440  COLOR W
  46. 1450  RETURN
  47. 1500  REM subroutine to print a single box
  48. 1510  COLOR B
  49. 1520  FOR I = R1 + 1 TO R2 - 1
  50. 1530   LOCATE I, C1 : PRINT CHR$(179);
  51. 1540   LOCATE I, C2 : PRINT CHR$(179);
  52. 1550  NEXT I
  53. 1560   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  54. 1590   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
  55. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  56. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  57. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  58. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  59. 1640  COLOR W
  60. 1650  RETURN
  61. 1700  REM ask user to press a key to continue
  62. 1710  LOCATE 25,1
  63. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  64. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  65. 1740  KEY ON : CLS : KEY OFF
  66. 2000  REM UPDATPER Program Starts Here.
  67. 2010  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  68. 2020  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  69. 2030  REM ask the user for input
  70. 2040  LOCATE 23,1 : PRINT SPACE$(79);
  71. 2050  LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
  72. 2060  LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
  73. 2070  LINE INPUT "Enter Record Number of Person to Update: "; REPLY$
  74. 2080  IF REPLY$ <> "?" THEN 2240
  75. 2090  REM Locate an unused record
  76. 2100  FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
  77. 2110  FOR LOOK = REC.NO TO MAX.PER
  78. 2120   GET #1, LOOK
  79. 2130   LOCATE 15,1 : PRINT "Searching Record";LOOK;
  80. 2140   T1 = CVS(F1$)
  81. 2150   IF T1 > 0 THEN 2170
  82. 2160   FOUND = 1 : REC.NO = LOOK : LOOK = MAX.PER
  83. 2170  NEXT LOOK
  84. 2180  IF FOUND = 1 THEN 2330
  85. 2190  PRINT "Unable to find an unused record above record";REC.NO
  86. 2200  PRINT "Either start from record 1 or extend the file"
  87. 2210  PRINT "Press any key to continue"
  88. 2220  A$ = INKEY$ : IF A$ = "" THEN 2220
  89. 2230  GOTO 2030
  90. 2240  IF REPLY$ = "0" THEN 6280
  91. 2250  REC.NO = VAL(REPLY$)
  92. 2260  IF REC.NO < 1 OR REC.NO > MAX.PER THEN 2270 ELSE 2320
  93. 2270  PRINT : PRINT "Number is out of range"
  94. 2280  PRINT "Press any key to continue"
  95. 2290  A$ = INKEY$ : IF A$ = "" THEN 2290
  96. 2300  KEY ON : CLS : KEY OFF
  97. 2310  GOTO 2030
  98. 2320  GET #1, REC.NO
  99. 2330  REM Extract information from the file for use
  100. 2340  T1! = CVS(F1$) : T1 = T1!
  101. 2350  REM Disallow Update if Rec.no is Zero (never Created)
  102. 2360  IF T1 <> 0 THEN 2420
  103. 2370  LOCATE 22,1 : PRINT SPACE$(79);: LOCATE 23,1 : PRINT SPACE$(79);: LOCATE 22,1
  104. 2380  PRINT "Record Number is Zero.  Must run the CREATPER Program First."
  105. 2390  LOCATE 25,1 : PRINT "Press any key to continue";
  106. 2400  A$ = INKEY$ : IF A$ = "" THEN 2400
  107. 2410  GOTO 6280  'Close the Files and return to the Menu
  108. 2420  T2$ = F2$          'Surname
  109. 2430  T3$ = F3$          'Given Names
  110. 2440  FOR J = 1 TO LEN(F3$)-1
  111. 2450   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  112. 2460  NEXT J
  113. 2470  T4$ = F4$          'Sex
  114. 2480  IF LEFT$(T4$,1) = MALE.LTR$    THEN T4$ = MALE.SEX$
  115. 2490  IF LEFT$(T4$,1) = FEMALE.LTR$  THEN T4$ = FEMALE.SEX$
  116. 2500  T5! = CVS(F5$)                'Code
  117. 2510  T6! = CVS(F6$) : T6 = T6!     'Father's No.
  118. 2520  T7! = CVS(F7$) : T7 = T7!     'Mother's No.
  119. 2530  T8$ = F8$          'Birthdate
  120. 2540  T9$ = F9$
  121. 2550  T10$ = F10$
  122. 2560  T11$ = F11$
  123. 2570  T12$ = F12$        'Death Date
  124. 2580  T13$ = F13$
  125. 2590  T14$ = F14$
  126. 2600  T15$ = F15$
  127. 2610  T16$ = F16$        'Burial Date
  128. 2620  T17$ = F17$
  129. 2630  T18$ = F18$
  130. 2640  T19$ = F19$
  131. 2650  KEY ON : CLS : KEY OFF
  132. 2660  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300  'Double box
  133. 2670  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3730  'Horizontal double
  134. 2680  LOCATE 2,3 : PRINT "Personal Information of:"
  135. 2690  R1 = 3 : C1 = 43 : R2 = 21 : C2 = 43 : GOSUB 3870  'Vertical Double
  136. 2700  LOCATE 4,3 : COLOR N : PRINT "Person:"; : COLOR O
  137. 2710  LOCATE 5,3 : PRINT "Record-number:";
  138. 2720  LOCATE 7,3 : PRINT "Surname:";
  139. 2730  LOCATE 9,3 : PRINT "Given-names:";
  140. 2740  LOCATE 11,3 : PRINT "Sex:";
  141. 2750  LOCATE 12,3 : PRINT "Code:";
  142. 2760  R1 = 13 : C1 = 1 : R2 =13 : C2 = 43 : GOSUB 3730  'Horizontal Double
  143. 2770  LOCATE 14,3 : COLOR N : PRINT "Person's Father:"; : COLOR O
  144. 2780  LOCATE 15,3 : PRINT "Record-number:";
  145. 2790  LOCATE 16,3 : PRINT "Name:";
  146. 2800  R1 = 17 : C1 = 1 : R2 = 17 : C2 = 43 : GOSUB 3800  'Horizontal Single
  147. 2810  LOCATE 18,3 : COLOR N : PRINT "Person's Mother:"; : COLOR O
  148. 2820  LOCATE 19,3 : PRINT "Record-number:";
  149. 2830  LOCATE 20,3 : PRINT "Name:";
  150. 2840  LOCATE 4,45 : COLOR N : PRINT "Person's Vital Statistics:"; : COLOR O
  151. 2850  LOCATE 6,45 : PRINT "Birth-date:";
  152. 2860  LOCATE 7,45 : PRINT "Birth-city:";
  153. 2870  LOCATE 8,45 : PRINT "Birth-county:";
  154. 2880  LOCATE 9,45 : PRINT "State/Country:";
  155. 2890  LOCATE 11,45 : PRINT "Death-date:";
  156. 2900  LOCATE 12,45 : PRINT "Death-city:";
  157. 2910  LOCATE 13,45 : PRINT "Death-county:";
  158. 2920  LOCATE 14,45 : PRINT "State/Country:";
  159. 2930  LOCATE 16,45 : PRINT "Burial-date:";
  160. 2940  LOCATE 17,45 : PRINT "Burial-city:";
  161. 2950  LOCATE 18,45 : PRINT "Burial-county:";
  162. 2960  LOCATE 19,45 : PRINT "State/Country:";
  163. 2970  GOSUB 2990 'To print the current information
  164. 2980  GOTO 3960 'For User Input
  165. 2990  REM Print the Information Currently Present
  166. 3000  LOCATE 2,28 : PRINT SPACE$(50); : COLOR W
  167. 3010  LOCATE 2,28 : PRINT LEFT$(T3$ + " " + T2$,50);
  168. 3020  LOCATE 6,8 : PRINT SPACE$(5);
  169. 3030  LOCATE 6,8 : COLOR G : PRINT T1;
  170. 3040  LOCATE 8,9 : PRINT SPACE$(20);
  171. 3050  LOCATE 8,9 : COLOR G : PRINT LEFT$(T2$,20);
  172. 3060  LOCATE 10,9 : PRINT SPACE$(30);
  173. 3070  LOCATE 10,9 : COLOR G : PRINT LEFT$(T3$,30);
  174. 3080  LOCATE 11,9 : PRINT SPACE$(20);
  175. 3090  LOCATE 11,9 : COLOR G : PRINT LEFT$(T4$,20);
  176. 3100  LOCATE 12,8 : PRINT SPACE$(15);
  177. 3110  LOCATE 12,8 : COLOR G : PRINT T5!;
  178. 3120  LOCATE 15,18 : PRINT SPACE$(5);
  179. 3130  LOCATE 15,18 : COLOR G : PRINT T6;
  180. 3140  REM Obtain the Father's Record
  181. 3150  IF T6 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3250
  182. 3160  GET #1, T6
  183. 3170  SN$ = F2$ : GN$ = F3$
  184. 3180  REM right-trim the names
  185. 3190  FOR J = 1 TO LEN(F2$)-1
  186. 3200   IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
  187. 3210  NEXT J
  188. 3220  FOR J = 1 TO LEN(F3$)-1
  189. 3230   IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
  190. 3240  NEXT J
  191. 3250  NM$ = SN$ + ", " + GN$
  192. 3260  IF SN$ = " " OR  GN$ = " " THEN NM$ = SN$ + " " + GN$
  193. 3270  IF SN$ = " " AND GN$ = " " THEN NM$ = " "
  194. 3280  LOCATE 16, 9 : PRINT SPACE$(33);
  195. 3290  LOCATE 16, 9 : COLOR G : PRINT LEFT$(NM$,33);
  196. 3300  LOCATE 19,18 : PRINT SPACE$(5);
  197. 3310  LOCATE 19,18 : COLOR G : PRINT T7;
  198. 3320  REM Obtain the Mother's Record
  199. 3330  IF T7 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3430
  200. 3340  GET #1, T7
  201. 3350  SN$ = F2$ : GN$ = F3$
  202. 3360  REM right-trim the names
  203. 3370  FOR J = 1 TO LEN(F2$)-1
  204. 3380   IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
  205. 3390  NEXT J
  206. 3400  FOR J = 1 TO LEN(F3$)-1
  207. 3410   IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
  208. 3420  NEXT J
  209. 3430  NM$ = SN$ + ", " + GN$
  210. 3440  IF SN$ = " " OR  GN$ = " " THEN NM$ = SN$ + " " + GN$
  211. 3450  IF SN$ = " " AND GN$ = " " THEN NM$ = " "
  212. 3460  LOCATE 20, 9 : PRINT SPACE$(33);
  213. 3470  LOCATE 20, 9 : COLOR G : PRINT LEFT$(NM$,33);
  214. 3480  LOCATE 6,60 : PRINT SPACE$(11);
  215. 3490  LOCATE 6,60 : COLOR G : PRINT T8$;
  216. 3500  LOCATE 7,60 : PRINT SPACE$(18);
  217. 3510  LOCATE 7,60 : COLOR G : PRINT T9$;
  218. 3520  LOCATE 8,60 : PRINT SPACE$(16);
  219. 3530  LOCATE 8,60 : COLOR G : PRINT T10$;
  220. 3540  LOCATE 9,60 : PRINT SPACE$(16);
  221. 3550  LOCATE 9,60 : COLOR G : PRINT T11$;
  222. 3560  LOCATE 11,60 : PRINT SPACE$(11);
  223. 3570  LOCATE 11,60 : COLOR G : PRINT T12$;
  224. 3580  LOCATE 12,60 : PRINT SPACE$(18);
  225. 3590  LOCATE 12,60 : COLOR G : PRINT T13$;
  226. 3600  LOCATE 13,60 : PRINT SPACE$(16);
  227. 3610  LOCATE 13,60 : COLOR G : PRINT T14$;
  228. 3620  LOCATE 14,60 : PRINT SPACE$(16);
  229. 3630  LOCATE 14,60 : COLOR G : PRINT T15$;
  230. 3640  LOCATE 16,60 : PRINT SPACE$(11);
  231. 3650  LOCATE 16,60 : COLOR G : PRINT T16$;
  232. 3660  LOCATE 17,60 : PRINT SPACE$(18);
  233. 3670  LOCATE 17,60 : COLOR G : PRINT T17$;
  234. 3680  LOCATE 18,60 : PRINT SPACE$(16);
  235. 3690  LOCATE 18,60 : COLOR G : PRINT T18$;
  236. 3700  LOCATE 19,60 : PRINT SPACE$(16);
  237. 3710  LOCATE 19,60 : COLOR G : PRINT T19$; : COLOR W
  238. 3720  RETURN
  239. 3730  REM Subroutine to draw a double horizontal line.  Attach to double.
  240. 3740  COLOR P
  241. 3750  LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  242. 3760  LOCATE R1,C1 : PRINT CHR$(204);
  243. 3770  LOCATE R1,C2 : PRINT CHR$(185);
  244. 3780  COLOR W
  245. 3790  RETURN
  246. 3800  REM Subroutine to draw a single horizontal line.  Attach to double.
  247. 3810  COLOR P
  248. 3820  LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  249. 3830  LOCATE R1,C1 : PRINT CHR$(199);
  250. 3840  LOCATE R1,C2 : PRINT CHR$(182);
  251. 3850  COLOR W
  252. 3860  RETURN
  253. 3870  REM Subroutine to draw a double vertical line.  Attach to double.
  254. 3880  COLOR P
  255. 3890  FOR I = R1 + 1 TO R2 - 1
  256. 3900   LOCATE I,C1 : PRINT CHR$(186);
  257. 3910  NEXT I
  258. 3920  LOCATE R1,C1 : PRINT CHR$(203);
  259. 3930  LOCATE R2,C1 : PRINT CHR$(202);
  260. 3940  COLOR W
  261. 3950  RETURN
  262. 3960  REM Routines to Obtain information from the User
  263. 3970  LOCATE 22,1 : PRINT SPACE$(79);
  264. 3980  LOCATE 23,1 : PRINT SPACE$(79);
  265. 3990  LOCATE 24,1 : PRINT SPACE$(79);
  266. 4000  KEY ON
  267. 4010  LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
  268. 4020  LOCATE 23,1
  269. 4030  LINE INPUT "Enter the Record Number: ";REPLY$
  270. 4040  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  271. 4050  IF REPLY$ = "/" THEN 5920
  272. 4060  IF REPLY$ = "" THEN 4170
  273. 4070  IF ABS(VAL(REPLY$)) = ABS(T1) THEN 4140 ELSE 4080
  274. 4080  REM Prevent Change of Rec.no
  275. 4090  LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
  276. 4100  PRINT "Cannot Change the Record Number to another number.";
  277. 4110  KEY OFF : LOCATE 25,1 : PRINT "Press any key to continue";
  278. 4120  A$ = INKEY$ : IF A$ = "" THEN 4120
  279. 4130  GOTO 3960
  280. 4140  T1 = VAL(REPLY$)
  281. 4150  IF T1 < 1 THEN GOSUB 6320 : GOSUB 2990 : GOTO 5920  'Negative
  282. 4160  GOSUB 2990
  283. 4170  LOCATE 23,1 : PRINT SPACE$(79);
  284. 4180  REM Terminate record update if rec.no is negative
  285. 4190  IF T1 < 0 THEN 5920
  286. 4200  LOCATE 23,1
  287. 4210  PRINT "Enter the Person's Surname (all capital letters): ";
  288. 4220  LINE INPUT REPLY$
  289. 4230  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  290. 4240  IF REPLY$ = "/" THEN 5920
  291. 4250  IF REPLY$ = "" THEN 4280
  292. 4260  T2$ = LEFT$(REPLY$,20)
  293. 4270  GOSUB 2990
  294. 4280  LOCATE 23,1 : PRINT SPACE$(79);
  295. 4290  LOCATE 23,1
  296. 4300  PRINT "Enter the Person's Given Names: ";
  297. 4310  LINE INPUT REPLY$
  298. 4320  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  299. 4330  IF REPLY$ = "/" THEN 5920
  300. 4340  IF REPLY$ = "" THEN 4370
  301. 4350  T3$ = LEFT$(REPLY$,30)
  302. 4360  GOSUB 2990
  303. 4370  LOCATE 23,1 : PRINT SPACE$(79); : LOCATE 23,1
  304. 4380  PRINT "Enter the Person's Sex (";MALE.LTR$;" for ";MALE.SEX$;
  305. 4390  PRINT " or ";FEMALE.LTR$;" for ";FEMALE.SEX$;"): ";
  306. 4400  LINE INPUT REPLY$
  307. 4410  LOCATE 24,1 : PRINT SPACE$(79);
  308. 4420  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  309. 4430  IF REPLY$ = "/" THEN 5920
  310. 4440  IF REPLY$ = "" THEN 4510
  311. 4450  T4$ = LEFT$(REPLY$,2)
  312. 4460  IF LEFT$(REPLY$,1) = CHR$(ASC(MALE.LTR$)+32) THEN T4$ = MALE.SEX$
  313. 4470  IF LEFT$(REPLY$,1) = MALE.LTR$ THEN T4$ = MALE.SEX$
  314. 4480  IF LEFT$(REPLY$,1) = CHR$(ASC(FEMALE.LTR$)+32) THEN T4$ = FEMALE.SEX$
  315. 4490  IF LEFT$(REPLY$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
  316. 4500  GOSUB 3080
  317. 4510  LOCATE 23,1 : PRINT SPACE$(79);
  318. 4520  LOCATE 23,1
  319. 4530  LINE INPUT "Enter the Person's Code: ";REPLY$
  320. 4540  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  321. 4550  IF REPLY$ = "/" THEN 5920
  322. 4560  IF REPLY$ = "" THEN 4590
  323. 4570  T5! = VAL(REPLY$)
  324. 4580  GOSUB 3100
  325. 4590  LOCATE 23,1 : PRINT SPACE$(79);
  326. 4600  LOCATE 23,1
  327. 4610  LINE INPUT "Enter the Father's Record Number: ";REPLY$
  328. 4620  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  329. 4630  IF REPLY$ = "/" THEN 5920
  330. 4640  IF REPLY$ = "" THEN 4700
  331. 4650  T6 = VAL(REPLY$)
  332. 4660  IF T6 >= 0 AND T6 <= MAX.PER THEN 4680
  333. 4670  LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4590
  334. 4680  LOCATE 22,1 : PRINT SPACE$(79);
  335. 4690  GOSUB 3120
  336. 4700  LOCATE 23,1 : PRINT SPACE$(79);
  337. 4710  LOCATE 23,1
  338. 4720  LINE INPUT "Enter the Mother's Record Number: ";REPLY$
  339. 4730  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  340. 4740  IF REPLY$ = "/" THEN 5920
  341. 4750  IF REPLY$ = "" THEN 4810
  342. 4760  T7 = VAL(REPLY$)
  343. 4770  IF T7 >= 0 AND T7 <= MAX.PER THEN 4790
  344. 4780  LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4700
  345. 4790  LOCATE 22,1 : PRINT SPACE$(79);
  346. 4800  GOSUB 3300
  347. 4810  LOCATE 23,1 : PRINT SPACE$(79);
  348. 4820  LOCATE 23,1
  349. 4830  PRINT "Enter the Person's Birth-date as: dd Mmm yyyy: ";
  350. 4840  LINE INPUT REPLY$
  351. 4850  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  352. 4860  IF REPLY$ = "/" THEN 5920
  353. 4870  IF REPLY$ = "" THEN 4910
  354. 4880  REPLY$ = LEFT$(REPLY$,11)
  355. 4890  RSET T8$ = REPLY$
  356. 4900  GOSUB 3480
  357. 4910  LOCATE 23,1 : PRINT SPACE$(79);
  358. 4920  LOCATE 23,1
  359. 4930  PRINT "Enter the Person's Birth-city: ";
  360. 4940  LINE INPUT REPLY$
  361. 4950  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  362. 4960  IF REPLY$ = "/" THEN 5920
  363. 4970  IF REPLY$ = "" THEN 5000
  364. 4980  T9$ = LEFT$(REPLY$,18)
  365. 4990  GOSUB 3500
  366. 5000  LOCATE 23,1 : PRINT SPACE$(79);
  367. 5010  LOCATE 23,1
  368. 5020  PRINT "Enter the Person's Birth-county: ";
  369. 5030  LINE INPUT REPLY$
  370. 5040  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  371. 5050  IF REPLY$ = "/" THEN 5920
  372. 5060  IF REPLY$ = "" THEN 5090
  373. 5070  T10$ = LEFT$(REPLY$,16)
  374. 5080  GOSUB 3520
  375. 5090  LOCATE 23,1 : PRINT SPACE$(79);
  376. 5100  LOCATE 23,1
  377. 5110  PRINT "Enter the Person's Birth-state or Country: ";
  378. 5120  LINE INPUT REPLY$
  379. 5130  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  380. 5140  IF REPLY$ = "/" THEN 5920
  381. 5150  IF REPLY$ = "" THEN 5180
  382. 5160  T11$ = LEFT$(REPLY$,16)
  383. 5170  GOSUB 3540
  384. 5180  LOCATE 23,1 : PRINT SPACE$(79);
  385. 5190  LOCATE 23,1
  386. 5200  PRINT "Enter the Person's Death-date as: dd Mmm yyyy: ";
  387. 5210  LINE INPUT REPLY$
  388. 5220  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  389. 5230  IF REPLY$ = "/" THEN 5920
  390. 5240  IF REPLY$ = "" THEN 5280
  391. 5250  REPLY$ = LEFT$(REPLY$,11)
  392. 5260  RSET T12$ = REPLY$
  393. 5270  GOSUB 3560
  394. 5280  LOCATE 23,1 : PRINT SPACE$(79);
  395. 5290  LOCATE 23,1
  396. 5300  PRINT "Enter the Person's Death-city: ";
  397. 5310  LINE INPUT REPLY$
  398. 5320  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  399. 5330  IF REPLY$ = "/" THEN 5920
  400. 5340  IF REPLY$ = "" THEN 5370
  401. 5350  T13$ = LEFT$(REPLY$,18)
  402. 5360  GOSUB 3580
  403. 5370  LOCATE 23,1 : PRINT SPACE$(79);
  404. 5380  LOCATE 23,1
  405. 5390  PRINT "Enter the Person's Death-county: ";
  406. 5400  LINE INPUT REPLY$
  407. 5410  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  408. 5420  IF REPLY$ = "/" THEN 5920
  409. 5430  IF REPLY$ = "" THEN 5460
  410. 5440  T14$ = LEFT$(REPLY$,16)
  411. 5450  GOSUB 3600
  412. 5460  LOCATE 23,1 : PRINT SPACE$(79);
  413. 5470  LOCATE 23,1
  414. 5480  PRINT "Enter the Person's Death-state or Country: ";
  415. 5490  LINE INPUT REPLY$
  416. 5500  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  417. 5510  IF REPLY$ = "/" THEN 5920
  418. 5520  IF REPLY$ = "" THEN 5550
  419. 5530  T15$ = LEFT$(REPLY$,16)
  420. 5540  GOSUB 3620
  421. 5550  LOCATE 23,1 : PRINT SPACE$(79);
  422. 5560  LOCATE 23,1
  423. 5570  PRINT "Enter the Person's Burial-date as: dd Mmm yyyy: ";
  424. 5580  LINE INPUT REPLY$
  425. 5590  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  426. 5600  IF REPLY$ = "/" THEN 5920
  427. 5610  IF REPLY$ = "" THEN 5650
  428. 5620  REPLY$ = LEFT$(REPLY$,11)
  429. 5630  RSET T16$ = REPLY$
  430. 5640  GOSUB 3640
  431. 5650  LOCATE 23,1 : PRINT SPACE$(79);
  432. 5660  LOCATE 23,1
  433. 5670  PRINT "Enter the Person's Burial-city: ";
  434. 5680  LINE INPUT REPLY$
  435. 5690  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  436. 5700  IF REPLY$ = "/" THEN 5920
  437. 5710  IF REPLY$ = "" THEN 5740
  438. 5720  T17$ = LEFT$(REPLY$,18)
  439. 5730  GOSUB 3660
  440. 5740  LOCATE 23,1 : PRINT SPACE$(79);
  441. 5750  LOCATE 23,1
  442. 5760  PRINT "Enter the Person's Burial-county: ";
  443. 5770  LINE INPUT REPLY$
  444. 5780  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  445. 5790  IF REPLY$ = "/" THEN 5920
  446. 5800  IF REPLY$ = "" THEN 5830
  447. 5810  T18$ = LEFT$(REPLY$,16)
  448. 5820  GOSUB 3680
  449. 5830  LOCATE 23,1 : PRINT SPACE$(79);
  450. 5840  LOCATE 23,1
  451. 5850  PRINT "Enter the Person's Burial-state or Country: ";
  452. 5860  LINE INPUT REPLY$
  453. 5870  IF REPLY$ = CHR$(34)+" "+CHR$(34) THEN REPLY$ = " "
  454. 5880  IF REPLY$ = "/" THEN 5920
  455. 5890  IF REPLY$ = "" THEN 5920
  456. 5900  T19$ = LEFT$(REPLY$,16)
  457. 5910  GOSUB 3700
  458. 5920  REM Input is complete, now see if user wants to save the data
  459. 5930  LOCATE 24,1 : PRINT SPACE$(79);
  460. 5940  LOCATE 23,1 : PRINT SPACE$(79);
  461. 5950  LOCATE 23,1
  462. 5960  LINE INPUT "Type s (save), m (more), or f (forget): ";REPLY$
  463. 5970  IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3960
  464. 5980  IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 3960
  465. 5990  IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2030
  466. 6000  IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2030
  467. 6010  IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6050
  468. 6020  IF LEFT$(REPLY$,1) = "S" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 6050
  469. 6030  LOCATE 22,1 : PRINT "Error in reply";
  470. 6040  GOTO 5940
  471. 6050  REM Routine to SAVE the newly updated record
  472. 6060  T1! = T1 : LSET F1$  = MKS$(T1!)
  473. 6070  LSET F2$  = T2$
  474. 6080  LSET F3$  = T3$
  475. 6090  LSET F4$  = LEFT$(T4$,1)
  476. 6100  LSET F5$  = MKS$(T5!)
  477. 6110  T6! = T6 : LSET F6$  = MKS$(T6!)
  478. 6120  T7! = T7 : LSET F7$  = MKS$(T7!)
  479. 6130  RSET F8$  = T8$
  480. 6140  LSET F9$  = T9$
  481. 6150  LSET F10$  = T10$
  482. 6160  LSET F11$  = T11$
  483. 6170  RSET F12$  = T12$
  484. 6180  LSET F13$  = T13$
  485. 6190  LSET F14$  = T14$
  486. 6200  LSET F15$  = T15$
  487. 6210  RSET F16$  = T16$
  488. 6220  LSET F17$  = T17$
  489. 6230  LSET F18$  = T18$
  490. 6240  LSET F19$  = T19$
  491. 6250  PUT #1, REC.NO
  492. 6260  KEY ON : CLS : KEY OFF
  493. 6270  GOTO 2030
  494. 6280  CLOSE #1
  495. 6290  KEY ON : CLS : KEY OFF : LOCATE 21,1
  496. 6300  PRINT "End of Program"
  497. 6310  RUN DD.MENU$+"menu"
  498. 6320  REM Blank out a negative record
  499. 6330  T2$ = ""
  500. 6340  T3$ = ""
  501. 6350  T4$ = ""
  502. 6360  T5 = 0
  503. 6370  T6 = 0
  504. 6380  T7 = 0
  505. 6390  T8$ = SPACE$(11)
  506. 6400  T9$ = ""
  507. 6410  T10$ = ""
  508. 6420  T11$ = ""
  509. 6430  T12$ = SPACE$(11)
  510. 6440  T13$ = ""
  511. 6450  T14$ = ""
  512. 6460  T15$ = ""
  513. 6470  T16$ = SPACE$(11)
  514. 6480  T17$ = ""
  515. 6490  T18$ = ""
  516. 6500  T19$ = ""
  517. 6510  RETURN
  518.